VAQPST01 ;ALB/JFP - PDX, POST INIT ROUTINE ;01JUN93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
EP ; -- Entry point
N POP
S POP=0
W @IOF
W !,"Begin of Post Init Process"
S XQABT1=$H
; -- List Man install
D PROT
D LIST
; -- File initialization
S XQABT2=$H
D EXPORT^VAQPST30
D PARM^VAQPST02 Q:POP
D UPDATE^VAQPST40
D AUTO^VAQPST02 Q:POP
D ENCR^VAQPST03 Q:POP
D REL^VAQPST03 Q:POP
D OUT^VAQPST03 Q:POP
D SEG^VAQPST03 Q:POP
; -- Mail groups
S XQABT3=$H
S X=$$MAIL^VAQPST10
S CNT=0
W !!
W !,"Creating Mail Groups for PDX"
I $E(X,1)=0 W !," 'VAQ PDX ERRORS' mail group created"
I $E(X,2)=0 W !," 'VAQ MANUAL PROCESSING' mail group created"
I $E(X,3)=0 W !," 'VAQ UNSOLICITED RECEIVED' mail group created"
;
I $E(X,1)=1 S CNT=CNT+1 W !," Error...Creating 'VAQ PDX ERRORS' mail group"
I $E(X,2)=1 S CNT=CNT+1 W !," Error...Creating 'VAQ MANUAL PROCESSING mail group"
I $E(X,3)=1 S CNT=CNT+1 W !," Error...Creating 'VAQ UNSOLICITED RECEIVED mail group"
I CNT>0 W !!,"Problem with creating mail groups, post init halted" QUIT
W !,"Mail Groups created"
T1 ;
W !!
S XQABT4=$H
D TASK^VAQPST20
T2 W !!
S X=$$REPEAT^VAQUTL1("*",79) W !,X
W !,"* IMPORTANT * The following things need to be done: "
W !,"*"
W !,"* - Members need to be added to the newly created mail groups."
W !,"* The option is XMEDITMG. "
W !,"*"
W !,"* - The PDX Server (VAQ-PDX-SERVER) needs to be edited in order "
W !,"* to associate a mail group with the server. The mail group "
W !,"* to add is 'VAQ PDX ERRORS'. The installer will also have "
W !,"* to change the server action from 'QUEUE SERVER ROUTINE' to"
W !,"* 'RUN IMMEDIATELY'"
W !,X
W !
D TERMTYP^VAQPST05
; -- send mail message on install to G.PDX DEVELOPERS@ISC-ALBANY.DOMAIN.EXT
S XQABT5=$H
S X="VAQINITY" X ^%ZOSF("TEST") I $T D @("^"_X)
W !!!,"Post init process completed"
K X,Y,CNT,DR,ENTRY,FLE,FILENO,FILE,J
QUIT
;
PROT ; -- Installs protocols used by list processor
W !!,"Installing protocols for use by the list processor"
D ^VAQONIT
W !!,"Protocol install completed"
QUIT
;
LIST ; -- Installs list templates
W !!,"Installing list templates for use by list processor"
D ^VAQPSL
W !!," ** List Template install completed"
QUIT
;
MISSING ; -- Builds DR string of fields with missing data
N ND,PC,FLD,CNT
S (ND,PC,FLD,DR)="",CNT=0
F S ND=$O(^DD(FILENO,"GL",ND)) Q:ND="" D M1
QUIT
M1 F S PC=$O(^DD(FILENO,"GL",ND,PC)) Q:PC="" D M2
QUIT
M2 S FLE=$S(ND?1N.N:FILE_ENTRY_","_ND_")",1:FILE_ENTRY_","_$C(34)_ND_$C(34)_")")
I $P($G(@FLE),U,PC)="" D M3
QUIT
M3 S FLD="",FLD=$O(^DD(FILENO,"GL",ND,PC,FLD))
S CNT=CNT+1
I CNT=1 S DR=DR_FLD
I CNT'=1 S DR=DR_";"_FLD
QUIT
;
PROMPT ; -- Prompts for missing fields
I DR="" W !!," ** File installed previously, all required fields present" QUIT
W !,"Enter missing field(s)",!
S DA=ENTRY,DIE=FILE
D ^DIE K DIE,DR,DA
W !!," ** Missing fields added, initialization complete",!
QUIT
;
END ; -- End of code
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQPST01 3093 printed Nov 22, 2024@17:36:25 Page 2
VAQPST01 ;ALB/JFP - PDX, POST INIT ROUTINE ;01JUN93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
EP ; -- Entry point
+1 NEW POP
+2 SET POP=0
+3 WRITE @IOF
+4 WRITE !,"Begin of Post Init Process"
+5 SET XQABT1=$HOROLOG
+6 ; -- List Man install
+7 DO PROT
+8 DO LIST
+9 ; -- File initialization
+10 SET XQABT2=$HOROLOG
+11 DO EXPORT^VAQPST30
+12 DO PARM^VAQPST02
if POP
QUIT
+13 DO UPDATE^VAQPST40
+14 DO AUTO^VAQPST02
if POP
QUIT
+15 DO ENCR^VAQPST03
if POP
QUIT
+16 DO REL^VAQPST03
if POP
QUIT
+17 DO OUT^VAQPST03
if POP
QUIT
+18 DO SEG^VAQPST03
if POP
QUIT
+19 ; -- Mail groups
+20 SET XQABT3=$HOROLOG
+21 SET X=$$MAIL^VAQPST10
+22 SET CNT=0
+23 WRITE !!
+24 WRITE !,"Creating Mail Groups for PDX"
+25 IF $EXTRACT(X,1)=0
WRITE !," 'VAQ PDX ERRORS' mail group created"
+26 IF $EXTRACT(X,2)=0
WRITE !," 'VAQ MANUAL PROCESSING' mail group created"
+27 IF $EXTRACT(X,3)=0
WRITE !," 'VAQ UNSOLICITED RECEIVED' mail group created"
+28 ;
+29 IF $EXTRACT(X,1)=1
SET CNT=CNT+1
WRITE !," Error...Creating 'VAQ PDX ERRORS' mail group"
+30 IF $EXTRACT(X,2)=1
SET CNT=CNT+1
WRITE !," Error...Creating 'VAQ MANUAL PROCESSING mail group"
+31 IF $EXTRACT(X,3)=1
SET CNT=CNT+1
WRITE !," Error...Creating 'VAQ UNSOLICITED RECEIVED mail group"
+32 IF CNT>0
WRITE !!,"Problem with creating mail groups, post init halted"
QUIT
+33 WRITE !,"Mail Groups created"
T1 ;
+1 WRITE !!
+2 SET XQABT4=$HOROLOG
+3 DO TASK^VAQPST20
T2 WRITE !!
+1 SET X=$$REPEAT^VAQUTL1("*",79)
WRITE !,X
+2 WRITE !,"* IMPORTANT * The following things need to be done: "
+3 WRITE !,"*"
+4 WRITE !,"* - Members need to be added to the newly created mail groups."
+5 WRITE !,"* The option is XMEDITMG. "
+6 WRITE !,"*"
+7 WRITE !,"* - The PDX Server (VAQ-PDX-SERVER) needs to be edited in order "
+8 WRITE !,"* to associate a mail group with the server. The mail group "
+9 WRITE !,"* to add is 'VAQ PDX ERRORS'. The installer will also have "
+10 WRITE !,"* to change the server action from 'QUEUE SERVER ROUTINE' to"
+11 WRITE !,"* 'RUN IMMEDIATELY'"
+12 WRITE !,X
+13 WRITE !
+14 DO TERMTYP^VAQPST05
+15 ; -- send mail message on install to G.PDX DEVELOPERS@ISC-ALBANY.DOMAIN.EXT
+16 SET XQABT5=$HOROLOG
+17 SET X="VAQINITY"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO @("^"_X)
+18 WRITE !!!,"Post init process completed"
+19 KILL X,Y,CNT,DR,ENTRY,FLE,FILENO,FILE,J
+20 QUIT
+21 ;
PROT ; -- Installs protocols used by list processor
+1 WRITE !!,"Installing protocols for use by the list processor"
+2 DO ^VAQONIT
+3 WRITE !!,"Protocol install completed"
+4 QUIT
+5 ;
LIST ; -- Installs list templates
+1 WRITE !!,"Installing list templates for use by list processor"
+2 DO ^VAQPSL
+3 WRITE !!," ** List Template install completed"
+4 QUIT
+5 ;
MISSING ; -- Builds DR string of fields with missing data
+1 NEW ND,PC,FLD,CNT
+2 SET (ND,PC,FLD,DR)=""
SET CNT=0
+3 FOR
SET ND=$ORDER(^DD(FILENO,"GL",ND))
if ND=""
QUIT
DO M1
+4 QUIT
M1 FOR
SET PC=$ORDER(^DD(FILENO,"GL",ND,PC))
if PC=""
QUIT
DO M2
+1 QUIT
M2 SET FLE=$SELECT(ND?1N.N:FILE_ENTRY_","_ND_")",1:FILE_ENTRY_","_$CHAR(34)_ND_$CHAR(34)_")")
+1 IF $PIECE($GET(@FLE),U,PC)=""
DO M3
+2 QUIT
M3 SET FLD=""
SET FLD=$ORDER(^DD(FILENO,"GL",ND,PC,FLD))
+1 SET CNT=CNT+1
+2 IF CNT=1
SET DR=DR_FLD
+3 IF CNT'=1
SET DR=DR_";"_FLD
+4 QUIT
+5 ;
PROMPT ; -- Prompts for missing fields
+1 IF DR=""
WRITE !!," ** File installed previously, all required fields present"
QUIT
+2 WRITE !,"Enter missing field(s)",!
+3 SET DA=ENTRY
SET DIE=FILE
+4 DO ^DIE
KILL DIE,DR,DA
+5 WRITE !!," ** Missing fields added, initialization complete",!
+6 QUIT
+7 ;
END ; -- End of code
+1 QUIT
