| 1 | VAQPST01 ;ALB/JFP - PDX, POST INIT ROUTINE ;01JUN93
|
---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
---|
| 3 | EP ; -- Entry point
|
---|
| 4 | N POP
|
---|
| 5 | S POP=0
|
---|
| 6 | W @IOF
|
---|
| 7 | W !,"Begin of Post Init Process"
|
---|
| 8 | S XQABT1=$H
|
---|
| 9 | ; -- List Man install
|
---|
| 10 | D PROT
|
---|
| 11 | D LIST
|
---|
| 12 | ; -- File initialization
|
---|
| 13 | S XQABT2=$H
|
---|
| 14 | D EXPORT^VAQPST30
|
---|
| 15 | D PARM^VAQPST02 Q:POP
|
---|
| 16 | D UPDATE^VAQPST40
|
---|
| 17 | D AUTO^VAQPST02 Q:POP
|
---|
| 18 | D ENCR^VAQPST03 Q:POP
|
---|
| 19 | D REL^VAQPST03 Q:POP
|
---|
| 20 | D OUT^VAQPST03 Q:POP
|
---|
| 21 | D SEG^VAQPST03 Q:POP
|
---|
| 22 | ; -- Mail groups
|
---|
| 23 | S XQABT3=$H
|
---|
| 24 | S X=$$MAIL^VAQPST10
|
---|
| 25 | S CNT=0
|
---|
| 26 | W !!
|
---|
| 27 | W !,"Creating Mail Groups for PDX"
|
---|
| 28 | I $E(X,1)=0 W !," 'VAQ PDX ERRORS' mail group created"
|
---|
| 29 | I $E(X,2)=0 W !," 'VAQ MANUAL PROCESSING' mail group created"
|
---|
| 30 | I $E(X,3)=0 W !," 'VAQ UNSOLICITED RECEIVED' mail group created"
|
---|
| 31 | ;
|
---|
| 32 | I $E(X,1)=1 S CNT=CNT+1 W !," Error...Creating 'VAQ PDX ERRORS' mail group"
|
---|
| 33 | I $E(X,2)=1 S CNT=CNT+1 W !," Error...Creating 'VAQ MANUAL PROCESSING mail group"
|
---|
| 34 | I $E(X,3)=1 S CNT=CNT+1 W !," Error...Creating 'VAQ UNSOLICITED RECEIVED mail group"
|
---|
| 35 | I CNT>0 W !!,"Problem with creating mail groups, post init halted" QUIT
|
---|
| 36 | W !,"Mail Groups created"
|
---|
| 37 | T1 ;
|
---|
| 38 | W !!
|
---|
| 39 | S XQABT4=$H
|
---|
| 40 | D TASK^VAQPST20
|
---|
| 41 | T2 W !!
|
---|
| 42 | S X=$$REPEAT^VAQUTL1("*",79) W !,X
|
---|
| 43 | W !,"* IMPORTANT * The following things need to be done: "
|
---|
| 44 | W !,"*"
|
---|
| 45 | W !,"* - Members need to be added to the newly created mail groups."
|
---|
| 46 | W !,"* The option is XMEDITMG. "
|
---|
| 47 | W !,"*"
|
---|
| 48 | W !,"* - The PDX Server (VAQ-PDX-SERVER) needs to be edited in order "
|
---|
| 49 | W !,"* to associate a mail group with the server. The mail group "
|
---|
| 50 | W !,"* to add is 'VAQ PDX ERRORS'. The installer will also have "
|
---|
| 51 | W !,"* to change the server action from 'QUEUE SERVER ROUTINE' to"
|
---|
| 52 | W !,"* 'RUN IMMEDIATELY'"
|
---|
| 53 | W !,X
|
---|
| 54 | W !
|
---|
| 55 | D TERMTYP^VAQPST05
|
---|
| 56 | ; -- send mail message on install to G.PDX DEVELOPERS@ISC-ALBANY.VA.GOV
|
---|
| 57 | S XQABT5=$H
|
---|
| 58 | S X="VAQINITY" X ^%ZOSF("TEST") I $T D @("^"_X)
|
---|
| 59 | W !!!,"Post init process completed"
|
---|
| 60 | K X,Y,CNT,DR,ENTRY,FLE,FILENO,FILE,J
|
---|
| 61 | QUIT
|
---|
| 62 | ;
|
---|
| 63 | PROT ; -- Installs protocols used by list processor
|
---|
| 64 | W !!,"Installing protocols for use by the list processor"
|
---|
| 65 | D ^VAQONIT
|
---|
| 66 | W !!,"Protocol install completed"
|
---|
| 67 | QUIT
|
---|
| 68 | ;
|
---|
| 69 | LIST ; -- Installs list templates
|
---|
| 70 | W !!,"Installing list templates for use by list processor"
|
---|
| 71 | D ^VAQPSL
|
---|
| 72 | W !!," ** List Template install completed"
|
---|
| 73 | QUIT
|
---|
| 74 | ;
|
---|
| 75 | MISSING ; -- Builds DR string of fields with missing data
|
---|
| 76 | N ND,PC,FLD,CNT
|
---|
| 77 | S (ND,PC,FLD,DR)="",CNT=0
|
---|
| 78 | F S ND=$O(^DD(FILENO,"GL",ND)) Q:ND="" D M1
|
---|
| 79 | QUIT
|
---|
| 80 | M1 F S PC=$O(^DD(FILENO,"GL",ND,PC)) Q:PC="" D M2
|
---|
| 81 | QUIT
|
---|
| 82 | M2 S FLE=$S(ND?1N.N:FILE_ENTRY_","_ND_")",1:FILE_ENTRY_","_$C(34)_ND_$C(34)_")")
|
---|
| 83 | I $P($G(@FLE),U,PC)="" D M3
|
---|
| 84 | QUIT
|
---|
| 85 | M3 S FLD="",FLD=$O(^DD(FILENO,"GL",ND,PC,FLD))
|
---|
| 86 | S CNT=CNT+1
|
---|
| 87 | I CNT=1 S DR=DR_FLD
|
---|
| 88 | I CNT'=1 S DR=DR_";"_FLD
|
---|
| 89 | QUIT
|
---|
| 90 | ;
|
---|
| 91 | PROMPT ; -- Prompts for missing fields
|
---|
| 92 | I DR="" W !!," ** File installed previously, all required fields present" QUIT
|
---|
| 93 | W !,"Enter missing field(s)",!
|
---|
| 94 | S DA=ENTRY,DIE=FILE
|
---|
| 95 | D ^DIE K DIE,DR,DA
|
---|
| 96 | W !!," ** Missing fields added, initialization complete",!
|
---|
| 97 | QUIT
|
---|
| 98 | ;
|
---|
| 99 | END ; -- End of code
|
---|
| 100 | QUIT
|
---|